#!/m1/shared/bin/perl -w

######################################################
##
## This script provides recommended bib records based
## on a provided bib record.
##
##
## The procedure is as follows:
##
## - Gets all the subject headings for the displayed bib record
## - Gets all the item IDs for the displayed bib record
## - Gets all patrons who have borrowed these items (relevant loans)
## - Gets the 15 overall most borrowed items by those patrons
## - Gets total number of loans for each of those 15 items (total loans)
## - Divides relevant loans by total loans to give an overall ranking.
##   The idea being that items with lots of total loans but fewer relevant
##   loans will be ranked below those with fewer total loans (i.e. the
##   item is mostly being borrowed by people with similar needs)
## - Bib ids, suppress status and titles for items are retrieved
## - Compares subject headings for the suggestions with the subject
##   headings of the original record, any correlations improve that
##   suggestion's ranking
## - The bibs are sorted by rank and returned
##
######################################################


#############################
# Start user editable stuff #
#############################

# Database SID
$ENV{ORACLE_SID} = "VGER";

# Path to Oracle
$ENV{ORACLE_HOME} = "/oracle/app/oracle/product/10.2.0/db_1";

# Voyager database details
my $vdbUser="xxx";
my $vdbPass="xxx";

# Secondary database details
my $sdbUser="xxx";
my $sdbPass="xxx";
my $sdbDb="xxx";
my $sdbHost="xxx";
my $sdbSid="xxx";

# Set a lower limit for number of relevant loans
my $minRelevantLoans=4;

# Determine whether to check that recommendations
# are the same format as the original item
# (i.e. if the original item is a book, only
# recommend books. This was put in to stop DVDs & video
# recordings being erroneously recommended when a
# book was the current item.
#
# NOTE: This check will only work if the words
# "video recording" appear in the bib title
# Therefore is it recommended this check be set to "n"
# for non-Aberystwyth installations 
my $formatCheck="y";

###########################
# End user editable stuff #
###########################


use DBI;
use CGI;
#use Data::Dumper;

# Get the bib id for the record being viewed
my $getBib=CGI::param('b');

# Set up the database connections
my $dbh_voyager = DBI->connect('dbi:Oracle:', $vdbUser, $vdbPass)
|| die "Could not connect: $DBI::errstr";

my $dbh_extra = DBI->connect("dbi:Oracle:database=$sdbDb;host=$sdbHost;sid=$sdbSid", $sdbUser, $sdbPass)
|| die "Could not connect: $DBI::errstr";

# Get this bib's title to determine whether we should
# only be showing video recordings or excluding them
my $sql_title="SELECT bt.title FROM bib_text bt WHERE bib_id='$getBib'";
my ($bib_title) = $dbh_voyager->selectrow_array($sql_title);

# Check if the title contains "video recording" or "videorecording"
my $origVideo = ($bib_title =~ /video\s??recording/i) ? 1 : 0;

# Get all this bib's subject headings
$sql_heading="SELECT distinct(h.heading_id) FROM bib_heading bh, heading h, heading_type ht WHERE bh.heading_id = h.heading_id and h.heading_type=ht.heading_type and ht.heading_type='a' and  bh.bib_id='$getBib'";
my $sth_heading = $dbh_voyager->prepare($sql_heading) || die $dbh_voyager->errstr;
$sth_heading->execute || die $dbh_voyager->errstr;

# Put all the subject headings in an array
my @refHeadings;
while( my (@headingline) = $sth_heading->fetchrow_array() ) {
   push (@refHeadings, $headingline[0]);
}

# Get all the items for this bib
$sql_items="SELECT item_id FROM bib_item WHERE bib_id='$getBib'";
my $sth_items = $dbh_voyager->prepare($sql_items) || die $dbh_voyager->errstr;
$sth_items->execute || die $dbh_voyager->errstr;

my @items;

while( my (@itemline) = $sth_items->fetchrow_array() ) {
   push (@items, $itemline[0]);
}

my $itemstr="'".join("','",@items)."'";

# Find all patrons who have borrowed this item
my $sql_patrons="SELECT patron_id FROM circ_trans_archive WHERE item_id IN ($itemstr)";
my $sth_patrons = $dbh_voyager->prepare($sql_patrons) || die $dbh_voyager->errstr;
$sth_patrons->execute || die $dbh_voyager->errstr;

my @patrons;

while( my (@line) = $sth_patrons->fetchrow_array() ) {
   push (@patrons, $line[0]);
}

my $patron_str="'".join("','",@patrons)."'";

# Get all items borrowed by these patrons ordered by frequency,
# only return the top 15 most borrowed items
my $sql_relevantLoans = "SELECT * FROM (SELECT item_id, count(*) AS freq FROM recommend2 WHERE patron_id IN ($patron_str) GROUP BY item_id ORDER BY freq DESC) WHERE ROWNUM <= 15";
$sth_relevantLoans = $dbh_extra->prepare($sql_relevantLoans) || die $dbh_extra->errstr;
$sth_relevantLoans->execute || die $dbh_extra->errstr;

my %bibs;
my %ranks;

# Iterate though each item
while( my (@itemline) = $sth_relevantLoans->fetchrow_array() ) {
   my $relevantLoans=$itemline[1];
   # If the number of relevant loans is higher than our
   # minimum
   if ($relevantLoans >= $minRelevantLoans) {
      # Get the total number of loans for this item
      my $sql_totalloans="SELECT count(*) FROM circ_trans_archive WHERE item_id='$itemline[0]'";
      my ($totalLoans) = $dbh_voyager->selectrow_array($sql_totalloans);
      # Calculate a ranking for this item
      $rank = $relevantLoans / $totalLoans;
      # Get bib id, supress status, title for this item
      my $sql_bibDetails="SELECT bi.bib_id, bm.suppress_in_opac, bt.title FROM bib_item bi, bib_master bm, bib_text bt WHERE bi.bib_id=bm.bib_id AND bm.bib_id=bt.bib_id AND bi.item_id='$itemline[0]'";
      my ($bib_id,$supress,$title) = $dbh_voyager->selectrow_array($sql_bibDetails);
      
      # Check if this is a video recording
      my $newVideo = ($title =~ /video\s??recording/i) ? 1 : 0;
      
      # If this item isn't suppressed and it's not the
      # original bib record and it's the same type as the
      # original (if we're doing that check)
      if (defined $bib_id && $supress eq "N" && $bib_id ne $getBib && ($formatCheck eq "n" || ($formatCheck eq "y" && $origVideo == $newVideo))) {
         # Put the rank in a hash
         $ranks{$bib_id}=$rank;
         # Put the details in a hash
         $bibs{$bib_id}={
            title  => $title,
         };
      }
   }
}

# Now we rank the bibs further by heavily
# weighting any records that are in the same
# subject headings as our original record

# For each of our records, get their subject headings
foreach my $bibKey (keys %bibs) {
   my $sql_bibHeading="SELECT distinct(h.heading_id) FROM bib_heading bh, heading h, heading_type ht WHERE bh.heading_id = h.heading_id and h.heading_type=ht.heading_type and ht.heading_type='a' and  bh.bib_id='$bibKey'";
   $sth_bibHeading = $dbh_voyager->prepare($sql_bibHeading) || die $dbh_voyager->errstr;
   $sth_bibHeading->execute || die $dbh_voyager->errstr;
   
   # Put all the subject headings in an array
   my @bibHeadingArr=();
   while( my (@bibHeadingLine) = $sth_bibHeading->fetchrow_array() ) {
      push (@bibHeadingArr, $bibHeadingLine[0]);
   }
   # If this bib has subject headings, check if any of them
   # match the subject headings for our original record
   if (scalar @bibHeadingArr > 0) {
      foreach my $thisBibHeading(@bibHeadingArr) {
         # If this bib does have a matching subject heading
         # double its ranking. The rank will be doubled for
         # every matching subject heading
         if (grep($thisBibHeading,@refHeadings)) {
            $ranks{$bibKey}=$ranks{$bibKey}*2;
         }
      }
   }
}

my $output;

# Sort all the bibs by rank
my $results=scalar keys %ranks;
if ($results > 0) {
   $output.="<ul id=\"recommended\" style=\"display:none\">";
   foreach my $rank (sort {$ranks{$b} cmp $ranks{$a} } keys %ranks) {
        $output.="<li><a href=\"http://voyager.aber.ac.uk/vwebv/holdingsInfo?bibId=$rank\" title=\"".$bibs{$rank}{'title'}."\">".$bibs{$rank}{'title'}."</a></li>";
   }
   $output.="</ul>";
}


# Output the results
print "Content-type: text/html\n\n";
if (length $output > 0) {
   print $output;
} else {
   print "-1";
}

